home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / C / SWEB.C < prev   
Encoding:
C/C++ Source or Header  |  1993-10-24  |  10.7 KB  |  455 lines
  1. /* SchemeWEB -- WEB for Scheme.  John D. Ramsdell.
  2.  * Simple support for literate programming in Scheme.
  3.  * This file generates both a Scheme weave program and
  4.  * a Scheme tangle program depending on if TANGLE is defined.
  5.  */
  6.  
  7. #if !defined lint
  8. static char ID[] = "$Header: sweb.c,v 1.2 90/07/17 07:25:01 ramsdell Exp $";
  9. static char copyright[] = "Copyright 1990 by The MITRE Corporation.";
  10. #endif
  11. /*
  12.  * Copyright 1990 by The MITRE Corporation
  13.  *
  14.  * This program is free software; you can redistribute it and/or modify
  15.  * it under the terms of the GNU General Public License as published by
  16.  * the Free Software Foundation; either version 1, or (at your option)
  17.  * any later version.
  18.  *
  19.  * This program is distributed in the hope that it will be useful,
  20.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  21.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22.  * GNU General Public License for more details.
  23.  * 
  24.  * For a copy of the GNU General Public License, write to the 
  25.  * Free Software Foundation, Inc., 675 Mass Ave, 
  26.  * Cambridge, MA 02139, USA.
  27.  */
  28.  
  29. /* SchemeWEB defines a new source file format in which source lines
  30. are divided into text and code.  Lines of code start with a line
  31. beginning with '(', and continue until the line that contains the
  32. matching ')'.  The text lines remain, and they are treated as
  33. comments.  If the first character of a text line is ';', it is
  34. stripped from the output.  This is provided for those who want to use
  35. an unmodified version of their Scheme system's LOAD.  When producing a
  36. document, both the text lines and the code lines are copied into the
  37. document source file, but the code lines are surrounded by a pair of
  38. formatting commands, as is comments beginning with ';' within code
  39. lines.  SchemeWEB is currently set up for use with LaTeX. */
  40.  
  41. /* Define TANGLE to make a program which translates SchemeWEB source
  42. into Scheme source. */
  43.  
  44. /* Define SAVE_LEADING_SEMICOLON if you want text lines to be copied 
  45. with any leading semicolon. */
  46.  
  47. #include <stdio.h>
  48.  
  49. typedef enum {FALSE, TRUE} bool;
  50.  
  51. #define putstring(s) (fputs(s, stdout))
  52.  
  53. #if defined TANGLE
  54. #define sweb_putchar(c) (putchar(c))
  55. #define text_putchar(c) (putchar(c))
  56. #else
  57. /* Modify the following for use with something other than LaTeX. */
  58. #define BEGIN_COMMENT    "\\notastyped{"
  59. #define BEGIN_CODE    "\\begin{astyped}"
  60. #define END_CODE    "\\end{astyped}"
  61. #define    BEGIN_VERB    "\\verb@"
  62. #define    END_VERB    "@"
  63.  
  64. struct {
  65.     unsigned char    c;
  66.     char    *s;
  67. }    table[] = {
  68.     { 128, "\\c{C}"},
  69.     { 129, "\\\"{u}"},
  70.     { 130, "\\'{e}"},
  71.     { 131, "\\^{a}"},
  72.     { 132, "\\\"{a}"},
  73.     { 133, "\\`{a}"},
  74.     { 134, "\\o{a}"},
  75.     { 135, "\\c{c}"},
  76.     { 136, "\\^{e}"},
  77.     { 137, "\\\"{e}"},
  78.     { 138, "\\`{e}"},
  79.     { 139, "\\\"{\\i}"},
  80.     { 140, "\\^{\\i}"},
  81.     { 141, "\\`{\\i}"},
  82.     { 142, "\\\"{A}"},
  83.     { 143, "\\o{A}"},
  84.     { 144, "\\'{E}"},
  85.     { 145, "\\ae "},
  86.     { 146, "\\AE "},
  87.     { 147, "\\^{o}"},
  88.     { 148, "\\\"{o}"},
  89.     { 149, "\\`{o}"},
  90.     { 150, "\\^{u}"},
  91.     { 151, "\\`{u}"},
  92.     { 152, "\\\"{y}"},
  93.     { 153, "\\\"{O}"},
  94.     { 154, "\\\"{U}"},
  95.     { 156, "\\pound "},
  96.     { 160, "\\'{a}"},
  97.     { 161, "\\'{\\i}"},
  98.     { 162, "\\'{o}"},
  99.     { 163, "\\'{u}"},
  100.     { 164, "\\~{n}"},
  101.     { 165, "\\~{N}"},
  102.     { 0, ""} };
  103.  
  104. void text_putchar (int c)
  105. {
  106.     int    i;
  107.     for( i = 0; table[i].c; i++ )
  108.         if( table[i].c == c )
  109.         {
  110.             putstring( table[i].s );
  111.             return;
  112.         }
  113.     putchar(c);
  114. }
  115.  
  116. void sweb_putchar (c)
  117.       int c;
  118. {                /* Raps \verb around characters */
  119.   switch (c) {            /* which LaTeX handles specially. */
  120.   case '\\': 
  121.   case  '{': 
  122.   case  '}': 
  123.   case  '$': 
  124.   case  '&': 
  125.   case  '#': 
  126.   case  '^': 
  127.   case  '_': 
  128.   case  '%': 
  129.   case  '~': 
  130.     putstring("\\verb-");
  131.     putchar(c);
  132.     putchar('-');
  133.     break;
  134.   default:
  135.     text_putchar(c);
  136.   }
  137. }
  138. #endif
  139.  
  140. /* Error message for end of file found in code. */
  141. bool report_eof_in_code()
  142. {
  143.   fprintf(stderr, "End of file within a code section.\n");
  144.   return TRUE;
  145. }
  146.  
  147. /* All input occurs in the following routines so that TAB characters
  148. can be expanded. TeX treats TAB characters as a space--not what is
  149. wanted. */
  150. int ch_buf;
  151. bool buf_used = FALSE;
  152. int lineno = 1;
  153.  
  154. #undef getchar()
  155. int getchar()
  156. {
  157.   int c;
  158.   static int spaces = 0;    /* Spaces left to print a TAB. */
  159.   static int column = 0;    /* Current input column. */
  160.   if (buf_used) {
  161.     buf_used = FALSE;
  162.     return ch_buf;
  163.   }
  164.   if (spaces > 0) {
  165.     spaces--;
  166.     return ' ';
  167.   }
  168.   switch (c = getc(stdin)) {
  169.   case '\t':
  170.     spaces = 7 - (7&column);    /* Maybe this should be 7&(~column). */
  171.     column += spaces + 1;
  172.     return ' ';
  173.   case '\n':
  174.     lineno++;
  175.     column = 0;
  176.     return c;
  177.   default:
  178.     column++;
  179.     return c;
  180.   }
  181. }
  182.  
  183. void ungetchar(c)
  184.      int c;
  185. {
  186.   buf_used = TRUE;
  187.   ch_buf = c;
  188. }
  189.  
  190. bool copy_text_saw_eof()
  191. {
  192.   int c;
  193.   while (1) {
  194.     c = getchar();
  195.     if (c == EOF) return TRUE;
  196.     if (c == '\n') return FALSE;
  197. #if !defined TANGLE
  198.     if (c == '\\')
  199.     {
  200.       putchar(c);
  201.       c = getchar();
  202.       if (c == EOF) return TRUE;
  203.       putchar(c);
  204.     } else
  205.     if (c == '|')        /* special verbatim */
  206.     {
  207.       if( (c = getchar()) == '|')
  208.     putchar(c);
  209.       else {
  210.         putstring(BEGIN_VERB);
  211.         do {
  212.           if (c == EOF) return TRUE;
  213.           else putchar(c);
  214.     } while ((c = getchar()) != '|');
  215.         putstring(END_VERB);
  216.       }
  217.     }
  218.     else text_putchar(c);
  219. #endif
  220.   }
  221. }
  222.  
  223. bool copy_comment_saw_eof()    /* This copies comments */
  224. {                /* within code sections. */
  225. #if !defined TANGLE  
  226.   putstring(BEGIN_COMMENT);
  227.   putchar(';');
  228. #endif  
  229.   if (copy_text_saw_eof()) return TRUE;
  230. #if !defined TANGLE  
  231.   putchar('}');
  232. #endif  
  233.   putchar('\n');
  234.   return FALSE;
  235. }
  236.  
  237. bool after_sexpr_failed()    /* Copies comments in a code */
  238. {                /* section that follow a */
  239.   int c;            /* complete S-expr. */
  240.   while (1)            /* It fails when there is */
  241.     switch (c = getchar()) {    /* something other than */ 
  242.     case EOF:            /* white space or a comment, */
  243.       return report_eof_in_code(); /* such as an extra ')'. */
  244.     case ';': 
  245. #if !defined TANGLE  
  246.       putstring(BEGIN_COMMENT);
  247.       putchar(c);
  248. #endif  
  249.       if (copy_text_saw_eof()) return report_eof_in_code();
  250. #if !defined TANGLE  
  251.       putchar('}');
  252. #endif  
  253.       putchar('\n');
  254.       return FALSE;
  255.     case '\n':
  256.       putchar(c);
  257.       return FALSE;
  258.     case ' ':
  259. #if !defined TANGLE
  260.       putchar(c);
  261. #endif
  262.       break;
  263.     default:
  264.       fprintf(stderr,
  265.           "Found \"%c\"  after an S-expr finished.\n",
  266.           c);
  267.       return TRUE;
  268.     }
  269. }
  270.  
  271. bool copy_string_saw_eof()
  272. {
  273.   int c;
  274.   while (1) {
  275.     c = getchar();
  276.     if (c == EOF) return TRUE;
  277.     sweb_putchar(c);
  278.     switch (c) {
  279.     case '"': return FALSE;
  280.     case '\\':
  281.       c = getchar();
  282.       if (c == EOF) return TRUE;
  283.       sweb_putchar(c);
  284.     }
  285.   }
  286. }
  287.  
  288. bool copy_symbol_saw_eof()
  289. {
  290.   int c;
  291.   while (1) {
  292.     c = getchar();
  293.     if (c == EOF) return TRUE;
  294.     sweb_putchar(c);
  295.     switch (c) {
  296.     case '|': return FALSE;
  297.     case '\\':
  298.       c = getchar();
  299.       if (c == EOF) return TRUE;
  300.       sweb_putchar(c);
  301.     }
  302.   }
  303. }
  304.  
  305. bool maybe_char_syntax_saw_eof()
  306. {                /* Makes sure that the character */
  307.   int c;            /* #\( does not get counted in */
  308.   c = getchar();        /* balancing parentheses. */
  309.   if (c == EOF) return TRUE;
  310.   if (c != '\\') {
  311.     ungetchar(c);
  312.     return FALSE;
  313.   }
  314.   sweb_putchar(c);
  315.   c = getchar();
  316.   if (c == EOF) return TRUE;
  317.   sweb_putchar(c);
  318.   return FALSE;
  319. }
  320.  
  321. bool copy_code_failed()        /* Copies a code section */
  322. {                /* containing one S-expr. */
  323.   int parens = 1;        /* Used to balance parentheses. */
  324.   int c;
  325.   while (1) {            /* While parens are not balanced, */
  326.     c = getchar();
  327.     if (c == EOF)        /* report failure on EOF and */
  328.       return report_eof_in_code();
  329.     if (c == ';')        /* report failure on EOF in a comment. */
  330.       if (copy_comment_saw_eof()) return report_eof_in_code();
  331.       else continue;
  332.     sweb_putchar(c);        /* Write the character and then see */
  333.     switch (c) {        /* if it requires special handling. */
  334.     case '(':
  335.       parens++;
  336.       break;
  337.     case ')':
  338.       parens--;            
  339.       if (parens == 0)        /* Parentheses balance! */
  340.     return after_sexpr_failed(); /* Report the result of */
  341.       break;            /* post S-expr processing. */
  342.     case '"':            /* Report failure on EOF in a string. */
  343.       if (copy_string_saw_eof()) {
  344.     fprintf(stderr, "End of file found within a string.\n");
  345.     return TRUE;
  346.       }
  347.       break;
  348.     case '|':            /* Report failure on EOF in a string. */
  349.       if (copy_symbol_saw_eof()) {
  350.     fprintf(stderr, "End of file found within a symbol.\n");
  351.     return TRUE;
  352.       }
  353.       break;
  354.     case '#':            /* Report failure on EOF in a character. */
  355.       if (maybe_char_syntax_saw_eof()) return report_eof_in_code();
  356.       break;
  357.     }
  358.   }
  359. }
  360.  
  361. int filter()
  362. {
  363.   int c;
  364.   while (1) {            /* At loop start it's in text mode */
  365.     c = getchar();        /* and at the begining of a line. */
  366.     if (c == '(') {        /* text mode changed to code mode. */
  367. #if !defined TANGLE
  368.       putstring(BEGIN_CODE); putchar('\n');
  369. #endif
  370.       do {            /* Copy code. */
  371.     putchar(c);
  372.     if (copy_code_failed()) {
  373.       fprintf(stderr,
  374.           "Error in the code section containing line %d.\n",
  375.           lineno);
  376.       return 1;
  377.     }
  378.     c = getchar();        /* Repeat when there is code */
  379.       } while (c == '(');    /* immediately after some code. */
  380. #if !defined TANGLE
  381.       fputs(END_CODE, stdout); putc('\n', stdout);
  382. #endif
  383.     }
  384.     /* Found a text line--now in text mode. */
  385. #if !defined SAVE_LEADING_SEMICOLON
  386.     if (c == ';') c = getchar();
  387. #endif
  388.     ungetchar(c);
  389.     if (copy_text_saw_eof()) return 0; /* Copy a text line. */
  390. #if !defined TANGLE
  391.     putchar('\n');
  392. #endif
  393.   }
  394. }
  395.  
  396. void    setext( char *name, char *ext, int force )
  397. {
  398.     int    i = strlen(name);
  399.  
  400.     while( --i && name[i] != '\\')
  401.     if( name[i] == '.')
  402.     {
  403.         if( force )
  404.             strcpy( name+i+1, ext );
  405.         return;
  406.     }
  407.     strcpy( name+strlen(name), ".");
  408.     strcpy( name+strlen(name), ext );
  409. }
  410.  
  411. int    main( int argc, char *argv[] )
  412. {
  413.     char    inname[100], outname[100];
  414.  
  415.     switch (argc)
  416.     {
  417.     case 3:
  418.         strcpy( outname, argv[2] );
  419.     case 2:
  420.         if( argc == 2 )
  421.             strcpy( outname, argv[1] );
  422.         setext( outname,
  423. #ifdef    TANGLE
  424.             "S",
  425. #else
  426.             "TEX",
  427. #endif
  428.             argc == 2 );
  429.  
  430.         strcpy( inname, argv[1] );
  431.         setext( inname, "SW", 0 );
  432.  
  433.         if( NULL == freopen( outname, "w", stdout) )
  434.         {
  435.             fprintf(stderr, "Cannot open %s for writing.\n", outname );
  436.             break;
  437.         }
  438.         if( NULL == freopen( inname, "r", stdin) )
  439.         {
  440.             fprintf(stderr, "Cannot open %s for reading.\n", inname );
  441.             break;
  442.         }
  443.     case 1:
  444.         return filter();
  445.     }
  446.     fprintf(stderr, 
  447. #ifdef    TANGLE
  448.         "Usage: %s [SchemeWEB file] [Scheme file]\n",
  449. #else
  450.         "Usage: %s [SchemeWEB file] [LaTeX file]\n", 
  451. #endif
  452.         argv[0]);
  453.     return    1;
  454. }
  455.